home *** CD-ROM | disk | FTP | other *** search
/ InfoMagic Internet Tools 1993 July / Internet Tools.iso / RockRidge / mail / pine / imap-3.0 / mapser / imapsv.mac < prev    next >
Encoding:
Text File  |  1989-01-11  |  9.2 KB  |  360 lines
  1.     TITLE IMAPSV - Multiforking mail access protocol listener
  2.     SUBTTL Derived from SMTJFN
  3.     SEARCH MACSYM,MONSYM
  4.     .REQUIRE SYS:MACREL
  5.     SALL            ; suppress macro expansions
  6.     .DIRECTIVE FLBLST    ; sane listings for ASCIZ, etc.
  7.     .TEXT "/NOINITIAL"    ; suppress loading of JOBDAT
  8.     .TEXT "IMAPSV/SAVE"    ; save as IMAPSV.EXE
  9.  
  10. ; Version components
  11.  
  12. IMPWHO==0            ; who last edited IMAPSV (0=developers)
  13. IMPVER==6            ; IMAPSV's release version (matches monitor's)
  14. IMPMIN==1            ; IMAPSV's minor version
  15. IMPEDT==^D2            ; IMAPSV's edit version
  16.  
  17. ;  This program manages a set of MAPSER forks, and uses TCP JFNs instead
  18. ; of TVTs for I/O.
  19. ;
  20. ;  The maximum number of simultaneous connections allowed is controlled
  21. ; by the setting of NFKS below.  The maximum number of forks to allow to
  22. ; exist after they have finished (in order to cut down on MAPSER startup
  23. ; overhead) is specified with MAXIDL.
  24.  
  25. IFNDEF MAXIDL,MAXIDL==2        ; maximum allowable idle forks
  26. IFNDEF NFKS,NFKS==^D30        ; maximum simultaneous connections
  27. IFNDEF PDLLEN,PDLLEN==200    ; PDL size
  28.  
  29. A=1                ; AC definitions
  30. B=2
  31. C=3
  32. D=4
  33. FX=14                ; fork table index of current fork
  34. CX=16
  35.  
  36. ; Fork variables
  37. ;
  38. ;  The current fork index (not a TOPS-20 fork handle) is always kept in
  39. ; FX, so indexing into the fork table is done implicitly by the following
  40. ; DEFSTRs.
  41.  
  42. DEFSTR FH,FKSTAT(FX),17,18    ; TOPS-20 fork handle
  43. DEFSTR FKRUN,FKSTAT(FX),18,1    ; set if fork is currently running
  44. DEFSTR FKJFN,FKSTAT(FX),35,9    ; fork's network JFN
  45.  
  46. DEFINE NOINT <CALL .NOINT>    ; disable PSI
  47. DEFINE OKINT <CALL .OKINT>    ; enable PSI
  48. DEFINE TMOSET (INTVL,RETAD) <
  49.     SETZM CLKCNT
  50.     PUSH P,[PC%USR+RETAD]
  51.     POP P,CLKLOC
  52.     PUSH P,[-<INTVL/5>]
  53.     POP P,CLKCNT
  54. >;DEFINE TMOSET
  55.  
  56. DEFINE TMOCLR <
  57.     SETZM CLKCNT
  58.     SETZM CLKLOC
  59. >;DEFINE TMOCLR
  60.     SUBTTL Data area
  61.  
  62. PC1:    BLOCK 1            ; level 1 interrupt PC
  63. IN1ACS:    BLOCK 20        ; level 1 AC save
  64. PC2:    BLOCK 1            ; level 2 interrupt PC
  65. IN2ACS:    BLOCK 20        ; level 2 AC save
  66. CLKCNT:    BLOCK 1            ; clock count
  67. CLKLOC:    BLOCK 1            ; clock location
  68. NRUN:    BLOCK 1            ; active fork count list
  69. NFORKS:    BLOCK 1            ; subfork count
  70. NJFNS:    BLOCK 1            ; connection count
  71. FKSTAT:    BLOCK NFKS        ; fork status
  72. PDL:    BLOCK PDLLEN        ; stack
  73.     SUBTTL Pure data
  74.  
  75. CHNTAB:    PHASE 0            ; interrupt channel table
  76. TIMCHN:!1,,TIMINT        ; timeout
  77.     BLOCK .ICIFT-.
  78. .ICIFT:!2,,FRKINT        ; fork termination interrupts
  79.     BLOCK ^D36-.
  80.     DEPHASE
  81.     
  82. LEVTAB:    PC1            ; level 1
  83.     PC2            ; level 2
  84.     BLOCK 1            ; level 3 unused
  85.     SUBTTL Main program
  86.  
  87. ; Entry vector
  88.  
  89. EVEC:    JRST IMAPSV        ; START address
  90.     JRST IMAPSV        ; REENTER address
  91.     <FLD IMPWHO,VI%WHO>!<FLD IMPVER,VI%MAJ>!<FLD IMPMIN,VI%MIN>!<FLD IMPEDT,VI%EDN>
  92. EVECL==.-EVEC
  93.  
  94. IMAPSV:    RESET%
  95.     MOVE P,[IOWD PDLLEN,PDL]
  96.     MOVX A,.FHSLF        ; enable all capabilities
  97.     RPCAP%
  98.     IORB C,B
  99.     EPCAP%
  100.     MOVE B,[LEVTAB,,CHNTAB]
  101.     SIR%            ; set up interrupt channels
  102.     EIR%            ; enable interrupts
  103.     MOVX B,1B<TIMCHN>!1B<.ICIFT> ; channels to interrupt on
  104.     AIC%            ; activate the interrupt channels
  105.     JSP CX,SETTIM        ; start the timer
  106.     GJINF%            ; get my job number
  107.     MOVE A,C
  108.     MOVX B,<JP%SYS!2>    ; get some response for the poor schmucks
  109.     SJPRI%
  110.     SETZM FKSTAT        ; clear the fork table
  111.     MOVE A,[FKSTAT,,FKSTAT+1]
  112.     BLT A,FKSTAT+NFKS-1
  113.     DO.
  114.       MOVE A,NRUN        ; get running fork count
  115.       CAIL A,NFKS        ; all in use?
  116.        WAIT%        ; yes, wait for one to complete
  117.       CALL LISTEN        ; listen for a connection
  118.       LOOP.            ; and go back for another one
  119.     ENDDO.
  120.     SUBTTL Interrupt routines
  121.  
  122. ; Here to initialize the timer, called via JSP CX,SETTIM.  Note that A,B,C
  123. ; are clobbered!
  124.  
  125. SETTIM:    MOVE A,[.FHSLF,,.TIMEL]    ; tick the timer
  126.     MOVX B,^D5000        ; every 5 seconds
  127.     MOVX C,TIMCHN        ; on TIMCHN channel
  128.     TIMER%
  129.      ERJMP .+1
  130.     JRST (CX)
  131.  
  132. ;;;Here on timer interrupt
  133. TIMINT:    MOVEM 17,IN1ACS+17    ; save ACs
  134.     MOVEI 17,IN1ACS
  135.     BLT 17,IN1ACS+16
  136.     JSP CX,SETTIM        ; reinitialize the timer
  137.     AOSE CLKCNT        ; should time out now?
  138.     IFSKP.
  139.       SKIPE A,CLKLOC    ; get time-out routine
  140.        MOVEM A,PC1        ; set it
  141.     ENDIF.
  142.     MOVSI 17,IN1ACS        ; restore ACs
  143.     BLT 17,17
  144.     DEBRK%
  145.  
  146. ; FRKINT is called on fork termination to scan the fork list to find
  147. ; any halted forks and close the corresponding connections.
  148.  
  149. FRKINT:    MOVEM 17,IN2ACS+17    ; save ACs
  150.     MOVEI 17,IN2ACS
  151.     BLT 17,IN2ACS+16
  152.     MOVE 17,IN2ACS+17
  153.     MOVE A,PC2        ; get interrupt pc location
  154.     MOVE A,-1(A)        ; get waiting instruction
  155.     CAME A,[WAIT%]        ; waiting for a free fork?
  156.     IFSKP.
  157.       SETONE PC%USR,PC2    ; yes, make JSYS return to user
  158.     ENDIF.
  159.     MOVSI FX,-NFKS        ; loop through all forks
  160.     DO.
  161.       IFQN. FKRUN        ; only "running" forks are checked
  162.         LOAD A,FH        ; get the fork handle
  163.         RFSTS%        ; get its status
  164.          ERJMP STOP
  165.         HRRZS B        ; flush flags from PC
  166.         LOAD D,RF%STS,A    ; get the fork status code
  167.         CAIE D,.RFHLT    ; halted?
  168.          CAIN D,.RFFPT    ; or terminated?
  169.           SOSA NRUN        ; yes, one less running fork
  170.       ANSKP.
  171.         SETZRO FKRUN    ; say fork is no longer running
  172.         CAIE D,.RFHLT    ; halted normally?
  173.         IFSKP.
  174.           MOVE A,NFORKS    ; get the number of existing forks
  175.           SUB A,NRUN    ; subtract balance of running forks
  176.           CAILE A,MAXIDL    ; too many free forks?
  177.         ANSKP.
  178.         ELSE.
  179.           LOAD A,FH        ; get the fork handle back
  180.           KFORK%        ; zap it
  181.            ERJMP STOP
  182.           SOS NFORKS    ; one less fork to worry about
  183.           SETZRO FH        ; say the fork is gone
  184.         ENDIF.
  185.         LOAD A,FKJFN    ; get the JFN
  186.         CALL CLSJFN        ; close the connection
  187.         SETZRO FKJFN    ; delete it from the table
  188.       ENDIF.
  189.       AOBJN FX,TOP.        ; loop if more forks to examine
  190.     ENDDO.
  191.     MOVSI 17,IN2ACS
  192.     BLT 17,17
  193.     DEBRK%            ; return from the interrupt
  194.      ERJMP STOP
  195.  
  196. ; CLSJFN - close the TCP connection
  197. ;
  198. ; Accepts:
  199. ;    A/ network JFN
  200. ; Returns:
  201. ;    +1 Always
  202.  
  203. CLSABT:    TXO A,CZ%ABT        ; abort the connection
  204. CLSJFN:    MOVE D,A        ; get a copy of the JFN
  205.     TMOSET (30,CLSABT)
  206.     CLOSF%            ; close it
  207.     IFJER.
  208.       TMOCLR
  209.       MOVE A,D        ; get the JFN back
  210.       RLJFN%        ; if close failed, just release JFN
  211.        ERJMP .+1
  212.     ENDIF.
  213.     TMOCLR
  214.     SOS NJFNS        ; one less connection
  215.     RET
  216.     SUBTTL LISTEN - listen for a connection
  217.  
  218. ; Listens for a connection on the TCP IMAP socket and starts up a copy
  219. ; of MAPSER.
  220. ;
  221. ; Returns:
  222. ;    +1 open failed
  223. ;    +2 open succeeded, IMAP fork started
  224.  
  225. LISTEN:    STKVAR <TCPJFN>        ; temp ac for storing JFN
  226.     DO.
  227.       MOVX A,GJ%SHT
  228.       HRROI B,[ASCIZ "TCP:143#;TIMEOUT:60"] ; wait 60 seconds for SYN
  229.       GTJFN%        ; get a JFN to listen on
  230.       IFJER.
  231.         MOVX A,^D<10*1000>    ; failed, wait a bit
  232.         DISMS%
  233.         LOOP.        ; and try again
  234.       ENDIF.
  235.       MOVEM A,TCPJFN    ; copy the JFN to a safe register
  236.       MOVX B,<OF%RD!OF%WR!<FLD ^D8,OF%BSZ>!<FLD .TCMWH,OF%MOD>>
  237.       OPENF%        ; wait for a connection
  238.       IFJER.
  239.         MOVE A,TCPJFN    ; get the JFN back
  240.         RLJFN%        ; through it away
  241.          ERJMP .+1
  242.         MOVX A,^D<10*1000>    ; failed, wait a bit
  243.         DISMS%
  244.         LOOP.        ; and try again
  245.       ENDIF.
  246.     ENDDO.
  247.     MOVX B,.TCSTP        ; reset retranmission timeout
  248.     SETZ C,            ; MAPSER will handle timeout
  249.     TCOPR%
  250.      ERJMP STOP
  251.     AOS NJFNS        ; bump connection count
  252.     GDSTS%            ; get the device status
  253.      ERJMP STOP
  254.     CALL GETFRK        ; find a free fork table entry
  255.     IFNSK.
  256.       MOVE A,TCPJFN
  257.       HRROI B,[ASCIZ/NO Insufficient system resources; please report this
  258. /]
  259.       SETZ C,
  260.       SOUTR%
  261.        ERJMP .+1
  262.       CALLRET CLSJFN    ; close the connection and return
  263.     ENDIF.
  264.     MOVE A,TCPJFN        ; get the JFN back
  265.     STOR A,FKJFN        ; save the JFN
  266.     LOAD A,FH        ; get the fork handle in a
  267.     LOAD B,FKJFN        ; get the JFN
  268.     HRLS B            ; B/ input JFN,,output JFN
  269.     SPJFN%            ; set the primary JFNs
  270.      ERJMP STOP
  271.     NOINT            ; defer interrupts
  272.     LOAD A,FH
  273.     SETZ B,            ; start the fork at normal entry
  274.     SFRKV%            ; start it
  275.      ERJMP STOP
  276.     SETONE FKRUN        ; say the fork has been started
  277.     AOS NRUN        ; bump running the running fork count
  278.     OKINT            ; allow interrupts again
  279.     RET            ; return to get another fork
  280.  
  281.     ENDSV.
  282.     SUBTTL GETFRK - allocate a fork
  283.  
  284. ;  Scan the fork table looking for an idle fork.  If one is found, its
  285. ; index is returned, otherwise a new fork is created unless the table is
  286. ; full.
  287. ;
  288. ; Returns:
  289. ;    +1 no more forks
  290. ;    +2 success, fork index in FX
  291.  
  292. GETFRK:    MOVSI FX,-NFKS        ; loop through all forks
  293.     DO.
  294.       IFQE. FKJFN        ; fork in use?
  295.         JN FH,,RSKP        ; no, if fork exists we can use it
  296.       AOBJN FX,TOP.
  297.       ENDIF.
  298.     ENDDO.
  299.  
  300. ; No idle fork exists, so create one if table can hold it
  301.  
  302.     MOVSI FX,-NFKS
  303.     DO.
  304.       IFQE. FKJFN        ; fork in use?
  305.         HRRZS FX        ; no, isolate the fork index
  306.         JN FH,,RSKP        ; if exists, idle fork appeared, use it
  307.         MOVX A,CR%CAP    ; else make one with our caps
  308.         CFORK%
  309.          ERJMP STOP
  310.         AOS NFORKS        ; bump the fork count
  311.         STOR A,FH        ; save the handle
  312.         TXZ A,.FHSLF
  313.         MOVX A,GJ%SHT!GJ%OLD
  314.         HRROI B,[ASCIZ/SYSTEM:MAPSER.EXE/]
  315.         GTJFN%        ; get a handle on the file
  316.          ERJMP STOP
  317.         LOAD B,FH        ; get the fork handle
  318.         HRL A,B        ; A/ fork,,JFN
  319.         GET%        ; load in the file
  320.          ERJMP STOP
  321.         RETSKP        ; return with FX set up
  322.       ENDIF.
  323.       AOBJN FX,TOP.        ; loop if more to try
  324.     ENDDO.
  325.     RET            ; otherwise fail
  326.     SUBTTL OKINT and NOINT - turn interrupts on and off
  327.  
  328. .OKINT:    SAVEAC <A>
  329.     MOVX A,.FHSLF
  330.     EIR%            ; enable interrupts
  331.     RET
  332.  
  333. .NOINT:    SAVEAC <A>
  334.     MOVX A,.FHSLF
  335.     DIR%            ; disable interrupts
  336.     RET
  337.     SUBTTL Other randomness
  338.  
  339. STOP:    HRROI A,[ASCIZ/IMAPSV: /]
  340.     ESOUT%
  341.     MOVX A,.PRIOU
  342.     HRLOI B,.FHSLF        ; dumb ERSTR%
  343.     SETZ C,
  344.     ERSTR%
  345.      NOP            ; undefined error number
  346.      NOP            ; can't happen
  347.     MOVX A,^D5000        ; sleep for 5 seconds
  348.     DISMS%
  349.     JRST IMAPSV        ; restart
  350.  
  351. ; Literals
  352.  
  353. ...VAR:!VAR            ; generate variables (there shouldn't be any)
  354. IFN .-...VAR,<.FATAL Variables illegal in this program>
  355. ...LIT:    XLIST            ; save trees during LIT
  356.     LIT            ; generate literals
  357.     LIST
  358.  
  359.     END EVECL,,EVEC        ; The End
  360.